home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / v10n05.arc / POPDATE.PRG < prev    next >
Text File  |  1991-02-13  |  2KB  |  79 lines
  1. ***********************************************************************
  2. *   Name: POPDATE.PRG
  3. * Author: Andrew Coupe
  4. *  Usage: <expD>=POPDATE(<row>,<col>,[<default>])
  5. *  Notes: UDF to popup a date selection box in FoxPRO 1.02
  6. ***********************************************************************
  7. FUNCTION POPDATE
  8. PARAMETER row,col,default
  9.  
  10. thismsg = SET("MESSAGE",1)            && Record current message line
  11. thisdate =_diarydate                  && Save original date
  12. *
  13. * --- If default date is passed, use it, else use _dairydate
  14. *
  15. DEFAULT = IIF( PARAMETERS()=3, default, _diarydate)
  16. _diarydate = default
  17.  
  18. DEFINE WINDOW CAL FROM row,col TO row+16,col+22 ;
  19. DOUBLE TITLE "[CALENDAR]"
  20. *
  21. * --- Need SET STATUS ON to see the following message
  22. *
  23. SET MESSAGE TO ;
  24. "Change date with arrow keys. [T]oday, Month:[PgUp/PgDn] Year:[^PgUp/^PgDn]"
  25.  
  26. ACTIVATE WINDOW cal
  27. ACTIVATE WINDOW calendar IN cal
  28. MOVE WINDOW calendar TO -1,-1        && Center calendar in window
  29.  
  30. DO WHILE LASTKEY() # 27              && While ESCAPE not HIT
  31.  
  32.    i=INKEY(0,"H")                    && Get keystroke
  33.    DO CASE
  34.     CASE i=13 .OR. i==27             && Enter or Esc
  35.       EXIT
  36.  
  37.     CASE i=84.OR. i=116              && 'T' for Today
  38.       _diarydate=DATE()
  39.  
  40.     CASE i =24                       && Down arrow
  41.       _diarydate=_diarydate+7
  42.  
  43.     CASE i= 5                        && Up arrow
  44.       _diarydate=_diarydate-7
  45.  
  46.     CASE i=19                        && Left arrow
  47.       _diarydate=_diarydate-1
  48.  
  49.     CASE i=4                         && Right arrow
  50.       _diarydate=_diarydate+1
  51.  
  52.     CASE i=3                         && Page down
  53.       _diarydate=gomonth(_diarydate,1)
  54.  
  55.     CASE i=18                        && Page up
  56.       _diarydate=gomonth(_diarydate,-1)
  57.  
  58.     CASE I= 30                       && ^Page down
  59.       _diarydate=gomonth(_diarydate,12)
  60.  
  61.     CASE I= 31                       && ^Page Up
  62.       _diarydate=gomonth(_diarydate,-12)
  63.    ENDCASE
  64. ENDDO
  65.  
  66. SET MESSAGE TO (thismsg)             && Restore message
  67. RELEASE WINDOWS cal                  && Release CAL windows
  68. *
  69. * --- Return default date if ESC was pressed
  70. *
  71. newdate = ;
  72. IIF( LASTKEY()=27, default, _diarydate)
  73.  
  74. _diarydate = thisdate                && Set system variable back
  75.  
  76. RETURN newdate                       && Return the selected date
  77.  
  78.  
  79.